home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 5 / The 640 Meg Shareware Studio CD-ROM Volume V (Data Express)(1994).ISO / basic / terminal.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-03  |  12.1 KB  |  539 lines
  1. ' Ansi modem terminal program for PowerBASIC
  2. ' Public Domain by Erik Olson
  3.  
  4. $OPTION CNTLBREAK OFF
  5. $COM 2048
  6. $STRING 4
  7. $LIB GRAPH OFF
  8. $LIB IPRINT OFF
  9. $LIB LPT ON
  10. $LIB COM ON
  11. $FLOAT EMULATE
  12. $COMPILE EXE
  13.  
  14. %FALSE = 0
  15. %TRUE  = NOT %FALSE
  16.  
  17. ' sound effects
  18. DECLARE SUB BELL()
  19. DECLARE SUB DAGNABBIT()
  20. DECLARE SUB FWEEP()
  21. DECLARE SUB FWOP()
  22. DECLARE SUB YIPPEE()
  23.  
  24. ' support routines
  25. DECLARE SUB TERMINAL(STRING)
  26. DECLARE FUNCTION POPDIR$(STRING)
  27.  
  28. ON ERROR GOTO ErrorHandler
  29.  
  30. DIM MENU$(10)
  31. SHARED MENU$(), TermScreen$, Termx%, Termy%, ScrnBuf%
  32.  
  33. CLS
  34. FWEEP
  35. MESSAGE "ANSI MODEM TERMINAL"
  36. DELAY .5
  37. MESSAGE "PowerBASIC 3.00b"
  38. DELAY .5
  39. MESSAGE "INITIALIZING PORTS"
  40. SETPORTS
  41. DELAY .3
  42. MESSAGE "VERIFY PARAMETERS"
  43. BELL
  44.  
  45. A$ = DIR$("OPENCOM.DAT")
  46. IF A$="" THEN
  47.     P$="COM2:2400,N,8,1,RS,CS,CD,DS,ME    "
  48. ELSE
  49.     OPEN A$ FOR INPUT AS #1
  50.     LINE INPUT #1, P$
  51.     CLOSE #1
  52. END IF
  53. P$=P$+SPACE$(40-LEN(P$))
  54. P$=EDITBOX$(P$)
  55. IF P$="" THEN END ELSE OPEN "OPENCOM.DAT" FOR OUTPUT AS #1:PRINT #1, P$:CLOSE
  56.  
  57. TERMINAL P$
  58.  
  59. LOCATE 25,1:END
  60.  
  61.  
  62. ' ==========[subroutines]=============
  63.  
  64.  
  65.  
  66. SUB TERMINAL(Parameter$)
  67. IF Parameter$ = "" THEN EXIT SUB
  68. ComBuf% = FREEFILE
  69. CapBuf% = 9
  70. PrnBuf% = 10
  71. OPEN Parameter$ FOR RANDOM AS #ComBuf%
  72. ScrnBuf% = FREEFILE
  73. OPEN "CONS:" FOR OUTPUT AS #ScrnBuf%
  74. IF LEN(TermScreen$) THEN
  75.     RESTORESCREEN TermScreen$:ANSILOCATE Termx%, Termy%
  76.     LOCATE Termx%,Termy%,1
  77. ELSE
  78.     CLS:ANSILOCATE 1,1:LOCATE 1,1,1
  79. END IF
  80. PRINT #ScrnBuf%, "PowerBASIC 3.00b Modem Terminal Program"
  81. PRINT #ScrnBuf%, "Terminal Mode ■ Press INSERT for menu"
  82. PRINT #ScrnBuf%, "RESETTING MODEM..."
  83. RESETMODEM ComBuf%
  84. BELL
  85.  
  86. DO
  87.     A$=INKEY$
  88.     IF A$=CHR$(27) THEN A$=CHR$(0,82)
  89.     IF LEN(A$) = 2 THEN
  90.         ANSICURSOR x%,y%
  91.         LOCATE x%,y%,0
  92.         SELECT CASE A$
  93.         CASE CHR$(0,45)   'alt-X = quit
  94.         CLS:PRINT "Wait...":RESETMODEM ComBuf%:PRINT "*** End Program"
  95.         LOCATE 25,1,1:CHAIN "PA(CAR).EXE"     'END
  96.  
  97.             CASE CHR$(0,72) '  up arrow
  98.             Print #Combuf%,chr$(27)+"]A";
  99.             CASE CHR$(0,75) '  left arrow
  100.             Print #Combuf%,chr$(27)+"]C";
  101.             CASE CHR$(0,77) '  right arrow
  102.             Print #Combuf%,chr$(27)+"]D";
  103.             CASE CHR$(0,79) '  end
  104.             Print #Combuf%,chr$(27)+"]K";
  105.             CASE CHR$(0,80) '  down arrow
  106.             Print #Combuf%,chr$(27)+"]B";
  107.             CASE CHR$(0,71) '  home
  108.             Print #Combuf%,chr$(27)+"]H";
  109.             CASE CHR$(0,83) '  Delete
  110.             Print #Combuf%,chr$(&H7F);
  111.  
  112.             CASE CHR$(0,104) ' ALT-F1
  113.             O$=SAVESCREEN$
  114.             FWEEP
  115.             IF Capture%=0 THEN MESSAGE "CAPTURE FILENAME:"
  116.             INCR Capture%
  117.             IF Capture% THEN Cap$=EditBox$("                      ")
  118.             IF Cap$="" THEN Capture%=0
  119.             FWEEP
  120.             IF Capture%=1 THEN
  121.                 Capture%=-1
  122.                 MESSAGE "CAPTURE ON"
  123.                 OPEN Cap$ FOR APPEND AS #CapBuf%
  124.             ELSE
  125.                 MESSAGE "CAPTURE OFF"
  126.                 CLOSE #CapBuf%
  127.             END IF
  128.             DELAY 1
  129.             RESTORESCREEN O$
  130.  
  131.             CASE CHR$(0,38)  ' ALT-L
  132.             O$=SAVESCREEN$
  133.             INCR Printer%
  134.             FWEEP
  135.             IF Printer%=1 THEN
  136.                 Printer%=-1
  137.                 MESSAGE "PRINTER ON"
  138.             ELSE
  139.                 MESSAGE "PRINTER OFF"
  140.             END IF
  141.             DELAY 1
  142.             RESTORESCREEN O$
  143.             CASE CHR$(0,35)  ' ALT-H
  144.                 O$=SAVESCREEN$
  145.                 FWEEP
  146.                 MESSAGE "RESETTING MODEM..."
  147.                 RESETMODEM Combuf%
  148.                 FWOP
  149.                 RESTORESCREEN O$
  150.         ANSILOCATE x%,y%
  151.                 CASE ELSE
  152.                 'menu
  153.                 O$ = SAVESCREEN$
  154.                 ANSICURSOR X%, Y%
  155.                 MENU$(1) = "Dial a Number  "
  156.         MENU$(2) = "Toggle Capture "
  157.         MENU$(3) = "Toggle Printing"
  158.         MENU$(4) = "End Session    "
  159.         MENU$(5) = ""
  160.                 FWEEP
  161.                 SELECT CASE POPMENU(MENU$())
  162.                         CASE 1
  163.                 O2$=SAVESCREEN$
  164.                 MESSAGE "Number to Dial"
  165.                 A$ = EDITBOX$("                      ")
  166.                 RESTORESCREEN O2$
  167.                 IF LEN(A$) THEN
  168.                     RESETMODEM ComBuf%
  169.                     DELAY 1
  170.                     PRINT #ComBuf%, "ATDT"+A$
  171.                 END IF
  172.  
  173.             CASE 2
  174.             FWEEP
  175.             IF Capture%=0 THEN MESSAGE "CAPTURE FILENAME:"
  176.             INCR Capture%
  177.             IF Capture% THEN Cap$=EditBox$("                      ")
  178.             IF Cap$="" THEN Capture%=0
  179.             FWEEP
  180.             IF Capture%=1 THEN
  181.                 Capture%=-1
  182.                 MESSAGE "CAPTURE ON"
  183.                 OPEN Cap$ FOR APPEND AS #CapBuf%
  184.             ELSE
  185.                 MESSAGE "CAPTURE OFF"
  186.                 CLOSE #CapBuf%
  187.             END IF
  188.             DELAY 1
  189.             CASE 3
  190.             INCR Printer%
  191.             FWEEP
  192.             IF Printer%=1 THEN
  193.                 Printer%=-1
  194.                 MESSAGE "PRINTER ON"
  195.             ELSE
  196.                 MESSAGE "PRINTER OFF"
  197.             END IF
  198.             DELAY 1
  199.             CASE 4   ' end session
  200.             MESSAGE "RESETTING MODEM"
  201.             RESETMODEM ComBuf%
  202.             AbortFlag% = %TRUE:CHAIN "PA(CAR).EXE"
  203.                         CASE ELSE
  204.                         FWOP
  205.                 END SELECT
  206.                 RESTORESCREEN O$
  207.         FWOP
  208.         ANSILOCATE X%,Y%
  209.         END SELECT
  210.         IF AbortFlag% THEN EXIT LOOP
  211.         ELSE  ' len a$ does not equal 2
  212.                 PRINT #ComBuf%,A$;
  213.     END IF ' len a$
  214.  
  215.                 IF LOC(ComBuf%) THEN
  216.                         A$=INPUT$(1,ComBuf%)
  217.                         IF A$=CHR$(8) THEN A$=CHR$(8)+" "+CHR$(8)
  218.                         IF A$ = CHR$(7) THEN A$ = "": BELL
  219.  
  220.             IF Printer% THEN LPRINT A$;
  221.             IF Capture% THEN PRINT #CapBuf%, A$;
  222.             PRINT #ScrnBuf% , A$;
  223.                 END IF
  224. LOOP
  225. CLOSE #ComBuf
  226. TermScreen$ = SAVESCREEN$
  227. ANSICURSOR Termx%, Termy%
  228. END
  229.  
  230. END SUB
  231.  
  232. SUB SETPORTS
  233. def seg=&h40
  234. poke 0,&hf8  '03F8  sets com1 address irq 4
  235. poke 1,&h03
  236. poke 2,&hf8  '02F8  sets com2 address irq 3
  237. poke 3,&h02
  238. poke 4,&he8  '03E8  sets com3 address irq 4
  239. poke 5,&h03
  240. poke 6,&he8  '02E8  sets com4 address irq 3
  241. poke 7,&h02
  242. def seg
  243.  
  244. END SUB
  245.  
  246. SUB RESETMODEM(m%)
  247.     DELAY 1.1
  248.     PRINT #m%,"+"; : DELAY .3
  249.     PRINT #m%,"+"; : DELAY .3
  250.     PRINT #m%,"+"; : DELAY 1.1
  251.     PRINT #m%,"ATZ"
  252.     DELAY .5
  253. END SUB
  254.  
  255.  
  256. FUNCTION SaveScreen$
  257. REG 1, 15*256
  258. CALL INTERRUPT &H10
  259. IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
  260. DEF SEG = ADDRESS
  261. SaveScreen$=PEEK$(0,4000)
  262. DEF SEG
  263. END FUNCTION
  264.  
  265. SUB RestoreScreen(S$)
  266. REG 1, 15*256
  267. CALL INTERRUPT &H10
  268. IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
  269. DEF SEG = Address
  270. POKE$ 0, S$
  271. DEF SEG
  272. END SUB
  273.  
  274. FUNCTION PopMenu(item$())
  275. ' Center a scrolling menu on the screen containing options in Item$()
  276. ' This function returns the number of the selected item, or 0 if ESC pressed.
  277. COLOR 0,7
  278. MenWid=0:MenHi=0
  279. DO:MenHi=MenHi+1:IF LEN(Item$(MenHi))>MenWid then MenWid=LEN(Item$(MenHi))
  280. LOOP WHILE LEN(Item$(MenHi))
  281. MenHi=MenHi:MenWid=MenWid+4
  282.  
  283. ' Menu box is MenHi x MenWid
  284.         wa% = 12 - (MenHi\2)
  285.         wb% = 40 - (MenWid\2)
  286.         wc% = wa% + MenHi
  287.         wd% = wb% + MenWid
  288. CALL SingleBox(Wa%,Wb%,Wc%,Wd%)
  289.  
  290. For y=1 to MenHi-1
  291.     Locate 12 - (MenHi\2) + y, 42 - (MenWid\2):Print Item$(y)
  292. Next y
  293.  
  294.     PopMe=1
  295.     DO
  296.     Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2),0
  297.          Color 7,0 : Print Item$(PopMe) : Color 0,7
  298.     do:a$ = Inkey$:loop while a$=""
  299.         If Len(a$) = 2 THEN a=asc(right$(a$,1)) else a=asc(a$)
  300.  
  301.  
  302.         SELECT CASE a
  303.  
  304.         CASE &H48 ' up arrow
  305.         Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
  306.         Print Item$(PopMe)
  307.         PopMe=PopMe-1
  308.         If PopMe = 0 then PopMe = MenHi-1
  309.  
  310.         CASE &H50 ' dn arrow
  311.         Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
  312.         Print Item$(PopMe)
  313.         PopMe=PopMe+1
  314.         If PopMe = MenHi then PopMe = 1
  315.  
  316.  
  317.         CASE &H47   ' home
  318.                 Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
  319.         Print Item$(PopMe)
  320.         PopMe=1
  321.  
  322.  
  323.         CASE      &H4D      ' right arrow ........ it could happen
  324.         CASE      &H4B      ' left arrow
  325.                     ' these keys might indicate that the
  326.                     ' user wants to move horizontally to
  327.                     ' another menu.  See CASEKEYS.BAS for
  328.                     ' a generic keyboard polling CASE struct
  329.  
  330.  
  331.  
  332.         CASE      &H51      ' page down
  333.         Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
  334.         Print Item$(PopMe)
  335.         PopMe=MenHi
  336.  
  337.         CASE      &H49      ' page up
  338.                 Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
  339.         Print Item$(PopMe)
  340.         PopMe=1
  341.  
  342.         CASE 27   ' escape
  343.         PopMenu=0 : Exit Loop
  344.  
  345.         CASE 13
  346.         PopMenu=PopMe : Exit Loop
  347.  
  348.         CASE ELSE
  349.         END SELECT
  350.  
  351.  
  352. loop
  353.  
  354. COLOR 7,0
  355. END FUNCTION
  356.  
  357.  
  358.  
  359.  
  360. FUNCTION EditBox$(Default$)
  361.  
  362. COLOR 0,7
  363. CALL SingleBox(19, 38-(LEN(Default$)\2), 21, 42+(LEN(Default$)\2))
  364. y = 40 - (LEN(Default$) \ 2) : YY=len(rtrim$(default$))
  365. DO
  366.  
  367.  
  368.    LOCATE 20,Y,0:PRINT Default$  ' if you want to put the box somewhere
  369.    LOCATE  20,Y+yy,1             ' else, change these locate statements
  370.  
  371.  
  372.    DO:A$=INKEY$:LOOP WHILE LEN(A$)=0
  373.    IF LEN(A$) THEN
  374.       SELECT CASE(A$)
  375.       CASE CHR$(27), CHR$(13)
  376.          EXIT SELECT
  377.       CASE CHR$(8)
  378.          IF YY THEN
  379.             YY=YY-1
  380.             IF YY THEN
  381.                Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "
  382.             ELSE
  383.                Default$=MID$(Default$,yy+2) + " "
  384.             END IF
  385.          END IF
  386.       CASE CHR$(0)+CHR$(83)
  387.          IF YY THEN
  388.             Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "
  389.          ELSE
  390.             Default$=MID$(Default$,yy+2) + " "
  391.          END IF
  392.       CASE CHR$(0)+CHR$(&H4D)
  393.          IF YY < LEN(Default$) THEN YY=YY+1
  394.       CASE CHR$(0)+CHR$(&H4B)
  395.          IF YY THEN YY=YY-1
  396.       CASE CHR$(0)+CHR$(79) 'end
  397.          yy=LEN(RTRIM$(default$))
  398.       CASE CHR$(0)+CHR$(71)
  399.          yy=0
  400.  
  401.       CASE ELSE
  402.          IF LEN(A$)=1 and YY=0 THEN Default$=SPACE$(LEN(default$))
  403.          IF LEN(A$)=1 and YY < LEN(Default$) THEN_
  404.          MID$(Default$,YY+1,1) = A$ : YY=YY+1
  405.  
  406.       END SELECT
  407.       IF A$=CHR$(27) THEN EditBox$="":EXIT LOOP
  408.       IF A$=CHR$(13) THEN EditBox$=RTRIM$(Default$):EXIT LOOP
  409.  
  410.    END IF
  411. LOOP
  412. COLOR 7,0
  413. END FUNCTION
  414.  
  415.  
  416. SUB SingleBox (Wa%, Wb%, Wc%, Wd%) PUBLIC
  417.  
  418. REG 1, 15*256
  419. CALL INTERRUPT &H10
  420. IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address&=&HB000 else Address&=&HB800
  421. DEF SEG = ADDRESS&
  422.  
  423.    LOCATE Wa%, Wb%,0: PRINT CHR$(213) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(184)
  424.    LOCATE Wc%, Wb%: PRINT CHR$(212) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(190)
  425.  
  426.    FOR zxy% = 1 TO Wc% - Wa% - 1
  427.       LOCATE Wa% + zxy%, Wb%
  428.       PRINT CHR$(179) + SPACE$((Wd% - Wb%) - 1) + CHR$(179)
  429.         ' right side of the box is Wa+zxy *80 + Wd + 1
  430.     ' stuff an attribute into there
  431.     POKE ( (Wa%+Zxy%) * 160 ) + (Wd%*2) + 1,8
  432.    NEXT zxy%
  433.         for i%=(Wc% * 160) + ((wb%+2)*2)-1 TO (Wc%*160) + ((Wd%*2)+2)-1 STEP 2
  434.         ' What this does is calculate the memory locations of the characters
  435.         ' in video ram
  436.         POKE i%, 8
  437.     Next i%
  438. DEF SEG
  439. END SUB
  440.  
  441. SUB Message (E$)
  442.    CALL SingleBox(10, 20, 12, 60)
  443.    LOCATE 11, 40 - (LEN(E$) \ 2)
  444.    PRINT E$;
  445. END SUB
  446.  
  447. FUNCTION YesNo (Prompt$)
  448. IF LEN(Prompt$) < 15 THEN Prompt$ = SPACE$(8 - LEN(Prompt$) \ 2) + Prompt$ + SPACE$(8 - LEN(Prompt$) \ 2)
  449. Wb% = 38 - LEN(Prompt$) \ 2
  450. Wd% = 42 + LEN(Prompt$) \ 2
  451. Wa% = CSRLIN
  452. Wc% = Wa% + 3
  453. CALL SingleBox(Wa%, Wb%, Wc%, Wd%)
  454. LOCATE Wa% + 1, 40 - LEN(Prompt$) \ 2: PRINT Prompt$
  455. YorN = -1
  456. LET YorN$ = "<Yes>    No "
  457. DO
  458.    LOCATE Wa% + 2, 34: PRINT YorN$
  459.    DO: A$ = INKEY$: LOOP WHILE A$ = ""
  460.    IF UCASE$(A$) = "Y" THEN YorN = -1
  461.    IF UCASE$(A$) = "N" THEN YorN = 0
  462.    IF A$ = CHR$(0) + CHR$(&H4D) THEN YorN = 0
  463.    IF A$ = CHR$(0) + CHR$(&H4B) THEN YorN = -1
  464.    IF A$ = CHR$(13) THEN EXIT LOOP
  465.    IF YorN THEN LET YorN$ = "<Yes>    No " ELSE LET YorN$ = " Yes    <No>"
  466.  
  467. LOOP
  468. YesNo = YorN
  469.  
  470. END FUNCTION
  471.  
  472. SUB SETHIBIT ' toggle blink to intensity bit
  473.     REG 1,&H1003
  474.     REG 2,0
  475.     CALL INTERRUPT &H10
  476. END SUB
  477.  
  478. SUB ANSILOCATE(ROW%, COL%)   'Sets BIOS cursor
  479.     LOCATE Row%,Col%,1
  480.     REG 1,&H0200
  481.     REG 2,0
  482.     REG 3,(Row%*256)+COL%
  483.     CALL INTERRUPT &H10
  484. END SUB
  485.  
  486. SUB ANSICURSOR(ROW%, COL%)   'Returns the current position of the cursor
  487. REG 1,&H0300
  488. REG 2,0
  489. CALL INTERRUPT &H10
  490. ROW% = (REG(4) \ 256) + 1
  491. COL% = (REG(4) AND &HFF) + 1
  492. END SUB
  493.  
  494. SUB FWEEP
  495. For y% = 800 TO 1800 STEP 200
  496. SOUND y%,.1
  497. NEXT y%
  498. END SUB
  499.  
  500. SUB FWOP
  501. FOR y% = 1800 TO 800 STEP -200
  502. SOUND y%, .1
  503. NEXT y%
  504. END SUB
  505.  
  506. SUB YIPPEE
  507. SOUND 1000,1:SOUND 2000,1:SOUND 3000,1
  508. END SUB
  509.  
  510. SUB DAGNABBIT
  511. SOUND 50,5
  512. END SUB
  513.  
  514. SUB BELL
  515. Sound 1000,.1
  516. SOUND 5000,.1
  517. SOUND 2500,.1
  518. SOUND 1000,.1
  519. DELAY 1
  520. END SUB
  521.  
  522.  
  523. ErrorHandler:
  524.  
  525. E = Err
  526. EO$=SAVESCREEN$
  527. DAGNABBIT
  528. FWOP:FWOP:FWOP
  529. MESSAGE "ERROR:" + STR$(E)
  530. LOCATE 19,1
  531. IF YesNo("Continue?") THEN RESTORESCREEN EO$:RESUME NEXT
  532. FWEEP
  533. LOCATE 19,1
  534. IF YesNo("Exit to DOS?") THEN CLS:END
  535. FWEEP
  536. RESTORESCREEN EO$:MESSAGE "RESETTING MODEM...":RESETMODEM ComBuf%
  537. RESTORESCREEN EO$
  538. RUN